# -*- cperl -*-

eval 'exec /emc/sgdb/runperl $0 $*'
    if 0 ;

use 5.6.0 ;
use warnings ;
use strict ;
use integer ;
use bytes ;

use Sancho::ParamsSmart ;

my $argv = join ' ', @ARGV ;
sub arg($) {my $re = shift ; ($argv || 'swuch') =~ /$re/ }
sub is_linux() { $^O eq 'linux' }

if ( $argv =~ /con(win)?/ ) {
    my $con  = ! $1 ;
    if ($ARGV[1]) {
        conwin($ARGV[1], $con) ;
    }
    else {
        conwin( 'WSW/swuch.exe',    $con ) ;
        conwin( 'WSW/runswuch.exe', $con ) ;
    }
    exit () ;
}

my @ver = qw(
              CompanyName=EMC
              FileDescription=Inlines
              FileVersion=4.00
              OriginalFileName=swuch.pl
              ProductVersion=4.00
              ProductName=Swuch
            ) ;
my $date = localtime ;
$date =~ y/ /-/ ;
push @ver, "InternalName=$date" ;

my @SNSL =
  qw(
        JaNet
        Compress::LZF
        Tk::JPEG
        Data::Dumper
        Sgdb::Tk::FileDialog
        LWP::Simple
        Sgdb::Tk::JBrowseEntry
        Sgdb::Tk::JFileDialog
        Sysc::*
        Sgdb::*
        Swuch::*
        Symm::*
        Sancho::*
   ) ;

#         Tk::MasterMenu
#         Swuch::SgdbRInvoker
make ( script => 'swuch.pl',
       exe    => is_linux ? 'swuch.linux.bin' : 'swuch.exe' ,
       mod    => \@SNSL,
  ) if arg 'swuch' ; # $doswuch ;


innosetup
  (
  ) if arg 'inst' ; # $doinst ;

make ( script => 'msw-runswuch.pl',
       exe => 'runswuch.exe',
  ) if arg 'run' ; # $dorun ;


make
  ( script => 'symmlink.pl',
    exe => 'symmlink.exe',
    mod => \@SNSL,
    con => 1,
  ) if arg 'symmlink' ; # $symmlink ;

my @not = qw/Tk Tk::*/ ;
make
  ( script => 'bin/mboxloader.pl',
    exe => 'mboxloader.exe',
    not => \@not,
  ) if arg 'mboxloader' ; # $mboxloader ;

make
  ( script => 'tst.stream.pl',
    exe => 'readsock.exe',
    not => \@not,
    mod => ['JaNet'],
    con => 1,
  ) if arg 'readsock' ; # $readsock ;

sub make {
    my %p = Params q/script exe ?mod ?not ?bind ?con=0/, @_ ;
    my $f = $p{exe};
    $f = "WSW/$f" ;
    print "make $f ..\n" ;
    unlink $f if -e $f ;
    my @base = ( ( is_linux ?
                   qw(/emc/jezra/local/LINUX/pdk-7.3/bin/perlapp --perl /emc/jezra/local/LINUX/Perl-AS-5.10/bin/perl) :
                   qw(perlapp.exe)
                 ),
                 qw( --nologo
                     --clean
                     --c
                     --icon=3.ico
                  ),
                 #                  --verbose
                 #                --icon=butterfly.small.ico
                 '--info="' . join (';', @ver) . '"' ,
                 #            '--xclude',
               ) ;
           #  -gui,

    sub foo($$) { join '', '--', $_[0], '="', join (';', @{$_[1] or return ()}), '"' }
    my @exe = (@base,
               "--script" => $p{script},
               "--exe" => $f,
               foo( add => $p{mod}),
               foo(trim => $p{not}),
               ) ;
    print "@exe\n" ;
    system @exe ;
    chmod 755 => $f if -e $f ;
    conwin( $f ) unless $p{consul};
    print "\n $f: done.\n" ;
}

sub innosetup {
  print "\n inno setup....\n" ;
  use File::Copy ;
  my $ex =
    system
      'c:/Program Files/Inno Setup 4/ISCC.exe',
        'WSW/swuch.iss' ;

  chmod 755 => 'WSW/SwucH.setup.exe' ;

#         'c:/WSW/swuch-setup.iss' ;
#   copy ( 'c:/WSW/Output/swuch-1.0-setup.exe', 'e:/sgdb_gui/WSW' )
#     unless $ex ;
}

sub conwin {
    return if is_linux ;
    my $f = shift ;
    print "\n conwin $f\n" ;
    my $make_console = shift ;
    my ($record,$magic,$offset,$size);
    open EXE, "+< $f" or die "Cannot open $f: $!";
    binmode EXE;
    read EXE, $record, 32*4;
    ($magic,$offset) = unpack "Sx58L", $record;
    die "Not an MSDOS executable file" unless $magic == 0x5a4d;
    seek EXE, $offset, 0;
    read EXE, $record, 24;
    ($magic,$size) = unpack "Lx16S", $record;
    die "PE header not found" unless $magic == 0x4550;
    die "Optional header not in NT32 format" unless $size == 224;
    seek EXE, $offset+24+68, 0;
    print EXE pack "S", $make_console ? 3 : 2 ;
    close EXE;
}


